home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / fract3d.arc / FRACT3D.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1980-01-01  |  5.7 KB  |  213 lines
  1. Program Fractal_Map;
  2. { This program draws a triangular fractal landscape. }
  3. { It takes a triangle, bisects the edges, and adjusts}
  4. { there height a proportional amount; then it does it}
  5. { all over again with the smaller triangles generated}
  6. { up to the maxt number of triangles per side.       }
  7. { It takes about 30 sec to calculate, then 30 to draw}
  8. {                                                    }
  9. { Scott R. Burke -- 1986,87                          }
  10. {                                                    }
  11.  
  12. const
  13.     maxt = 33; { number of subdivisions of the triangle }
  14.     frac = 5;  { ?? }
  15.  
  16. type
  17.   point = record
  18.              x,y,z : real;
  19.              c:integer;
  20.           end;
  21.  
  22. var
  23.    mat : array[1..maxt,1..maxt] of point;
  24.    i,j,k : integer;
  25.    l,m,n : real;
  26.    ch : char;
  27.    depth : real;
  28.    min,max : real;
  29.    levela,levelb:real;
  30.  
  31.  
  32.  
  33. procedure dofold(ai,aj,bi,bj,ci,cj:integer);
  34. { take the triangle anchored at (ai,aj),(bi,bj),(ci,cj) }
  35. { and generate new heights for the midpoints of each    }
  36. { side of the triangle (a',b',c')                       }
  37.  
  38. label 99;
  39. type
  40.    matcoord = record i,j : integer; end;
  41. var
  42.    ap,bp,cp : matcoord;
  43.    l : real;
  44. begin
  45.    if (abs(ai-bi)=1)or(abs(aj-bj)=1) then goto 99; { skip procedure }
  46.  
  47.    {***************************** A PRIME ***********************************}
  48.    { calculate a prime }
  49.    ap.i := (ai+bi) div 2;
  50.    ap.j := (aj+bj) div 2;
  51.  
  52.    { get the coordinate values for a prime }
  53.    mat[ap.i,ap.j].x := (mat[ai,aj].x + mat[bi,bj].x) / 2;
  54.    mat[ap.i,ap.j].y := (mat[ai,aj].y + mat[bi,bj].y) / 2;
  55.    mat[ap.i,ap.j].z := (mat[ai,aj].z + mat[bi,bj].z) / 2;
  56.    { calculate new height }
  57.    l := sqrt(sqr(mat[ai,aj].x-mat[bi,bj].x)+sqr(mat[ai,aj].y-mat[bi,bj].y));
  58.    mat[ap.i,ap.j].z := mat[ap.i,ap.j].z + (2*(random-0.5)/frac)*l;
  59.  
  60.    {***************************** B PRIME ***********************************}
  61.    { calculate b prime }
  62.    bp.i := (ai+ci) div 2;
  63.    bp.j := (aj+cj) div 2;
  64.  
  65.    { get the coordinate values for b prime }
  66.    mat[bp.i,bp.j].x := (mat[ai,aj].x + mat[ci,cj].x) / 2;
  67.    mat[bp.i,bp.j].y := (mat[ai,aj].y + mat[ci,cj].y) / 2;
  68.    mat[bp.i,bp.j].z := (mat[ai,aj].z + mat[ci,cj].z) / 2;
  69.    { calculate new height }
  70.    l := sqrt(sqr(mat[ai,aj].x-mat[ci,cj].x)+sqr(mat[ai,aj].y-mat[ci,cj].y));
  71.    mat[bp.i,bp.j].z := mat[bp.i,bp.j].z + (2*(random-0.5)/frac)*l;
  72.  
  73.    {***************************** C PRIME ***********************************}
  74.    { calculate c prime }
  75.    cp.i := (bi+ci) div 2;
  76.    cp.j := (bj+cj) div 2;
  77.  
  78.    { get the coordinate values for a prime }
  79.    mat[cp.i,cp.j].x := (mat[bi,bj].x + mat[ci,cj].x) / 2;
  80.    mat[cp.i,cp.j].y := (mat[bi,bj].y + mat[ci,cj].y) / 2;
  81.    mat[cp.i,cp.j].z := (mat[bi,bj].z + mat[ci,cj].z) / 2;
  82.    { calculate new height }
  83.    l := sqrt(sqr(mat[ci,cj].x-mat[bi,bj].x)+sqr(mat[ci,cj].y-mat[bi,bj].y));
  84.    mat[cp.i,cp.j].z := mat[cp.i,cp.j].z + (2*(random-0.5)/frac)*l;
  85.  
  86.    {**************** do next level ******************************************}
  87.    dofold(ai,aj,ap.i,ap.j,bp.i,bp.j);
  88.    dofold(bp.i,bp.j,ci,cj,cp.i,cp.j);
  89.    dofold(ap.i,ap.j,bi,bj,cp.i,cp.j);
  90.    dofold(ap.i,ap.j,bp.i,bp.j,cp.i,cp.j);
  91.    99: { procedure skipped }
  92. end;
  93.  
  94.  
  95.  
  96. procedure plot_triangle(i,j:integer);
  97. var
  98.    ax,ay,bx,by,cx,cy,l1,l2,l3 : integer;
  99.  
  100.    function adjx(x,y:real):integer;
  101.    { adjust the x-coord for tilted perspective }
  102.    begin
  103.    adjx := round(783.00*(x-50.00)/(261.00+y))+160;
  104.    end;
  105.  
  106.    function adjy(y,z:real):integer;
  107.    { adjust the y-coord for tilted perspective }
  108.    begin
  109.    adjy := 200 - round((z*500.00)/(261.00+y));
  110.    end;
  111.  
  112. begin
  113.    { figure the adjusted x-screen values for a,b and c }
  114.    ax :=  adjx(mat[i,j].x,mat[i,j].y);
  115.    bx :=  adjx(mat[i+1,j+1].x,mat[i+1,j+1].y);
  116.    cx :=  adjx(mat[i+1,j].x,mat[i+1,j].y);
  117.  
  118.    { figure the adjusted y-screen values for a,b and c }
  119.    ay :=  adjy(mat[i,j].y,mat[i,j].z);
  120.    by :=  adjy(mat[i+1,j+1].y,mat[i+1,j+1].z);
  121.    cy :=  adjy(mat[i+1,j].y,mat[i+1,j].z);
  122.  
  123.    { plot the lines }
  124.  
  125.    draw(ax,ay,bx,by,1);
  126.    draw(ax,ay,cx,cy,1);
  127.    draw(bx,by,cx,cy,1);
  128. end;
  129.  
  130. procedure init_matrix;
  131. begin
  132.    mat[1,1].x := 0.00;
  133.    mat[1,1].y := 0.00;
  134.    mat[1,1].z := 0.00;
  135.  
  136.    mat[maxt,1].x := 100.00;
  137.    mat[maxt,1].y := 0.00;
  138.    mat[maxt,1].z := 0.00;
  139.  
  140.    mat[maxt,maxt].x := 50.00;
  141.    mat[maxt,maxt].y := 86.60;
  142.    mat[maxt,maxt].z := 0.00;
  143. end;
  144.  
  145. procedure adjust_landscape;
  146. { adjust the coordinates for tilted down viewing of surface }
  147. var i,j : integer;
  148.     depth : real;
  149. begin
  150.    { rotate the rear up 30 degrees }
  151.    for i := 1 to maxt do
  152.       for j := i to maxt do
  153.       begin
  154.          depth := 87.00 - mat[j,i].y;
  155.          mat[j,i].z := mat[j,i ].z + (depth*0.58);
  156.       end;
  157.  
  158.    { raise all z up from sea level }
  159.    for i := 1 to maxt do
  160.       for j := i to maxt do
  161.          mat[j,i].z := mat[j,i].z + 15.00;
  162. end;
  163.  
  164. procedure draw_matrix;
  165. var i,j : integer;
  166. begin
  167.    for i := 1 to maxt-1 do
  168.       for j := i to maxt-1 do
  169.       begin
  170.          plot_triangle(j,i);
  171.       end;
  172. end;
  173.  
  174. procedure calc_matrix;
  175. { calculate the triangular matrix (1,1)-(max,max)-(max,1) }
  176. begin
  177.    dofold(1,1,maxt,maxt,maxt,1);
  178. end;
  179.  
  180.  
  181. begin
  182. {$U+}
  183. ClrScr;
  184. GotoXY(15,10);
  185. Writeln('*** *** *** FRACTAL LANDSCAPES *** *** ***');
  186. GotoXY(15,13);
  187. Writeln('          By  Scott R. Burke');
  188. GotoXY(15,22);
  189. Writeln('      ** Press any key to begin **');
  190.  
  191. while not (keypressed) do
  192.    delay(10);
  193.  
  194. randomize;
  195. graphmode;
  196. palette(1);
  197.  
  198. while keypressed do
  199.    read(kbd,ch); { flush the keyboard buffer }
  200.  
  201. { draw a landscape  }
  202. Writeln('Generating landscape, please wait ....');
  203. init_matrix;
  204. calc_matrix;
  205. adjust_landscape;
  206. graphmode;
  207. draw_matrix;
  208.  
  209. Gotoxy(1,1);
  210. Writeln('Press a key to quit');
  211. Repeat until keypressed;
  212. Textmode;
  213. end.